Delphi Programmer's Power Pack/Delphi Volume 1.iso/e_to_l/llocx1/msvb.z/VIEWIMG.FRM

Text File | 1996-02-13 | 7KB | 246 lines

VERSION 4.00
Begin VB.Form WinSeek
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Image Viewer"
   ClientHeight    =   6450
   ClientLeft      =   2460
   ClientTop       =   1725
   ClientWidth     =   11370
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H00000080&
   Height          =   6855
   Left            =   2400
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6450
   ScaleWidth      =   11370
   ShowInTaskbar   =   0   'False
   Top             =   1380
   Width           =   11490
   Begin VB.CommandButton FitInHeight
      Caption         =   "Fit in &Height"
      Height          =   345
      Left            =   360
      TabIndex        =   11
      Top             =   5160
      Width           =   1245
   End
   Begin VB.CommandButton FitRelease
      Caption         =   "&Release Fit"
      Height          =   345
      Left            =   360
      TabIndex        =   10
      Top             =   5640
      Width           =   1230
   End
   Begin VB.CommandButton FitInWidth
      Caption         =   "Fit in &Width"
      Height          =   345
      Left            =   360
      TabIndex        =   9
      Top             =   4680
      Width           =   1230
   End
   Begin VB.CommandButton FitBest
      Caption         =   "&Best Fit"
      Height          =   345
      Left            =   360
      TabIndex        =   8
      Top             =   4215
      Width           =   1245
   End
   Begin VB.PictureBox Picture1
      BorderStyle     =   0  'None
      Height          =   3015
      Left            =   120
      ScaleHeight     =   3015
      ScaleWidth      =   4695
      TabIndex        =   1
      Top             =   120
      Width           =   4695
      Begin VB.DriveListBox drvList
         Height          =   315
         Left            =   2040
         TabIndex        =   6
         Top             =   480
         Width           =   2535
      End
      Begin VB.DirListBox dirList
         Height          =   1605
         Left            =   2040
         TabIndex        =   5
         Top             =   960
         Width           =   2535
      End
      Begin VB.FileListBox filList
         Height          =   2010
         Left            =   120
         TabIndex        =   4
         Top             =   465
         Width           =   1815
      End
      Begin VB.TextBox txtSearchSpec
         Height          =   285
         Left            =   2040
         TabIndex        =   3
         Text            =   "*.*"
         Top             =   0
         Width           =   2535
      End
      Begin VB.Label lblCriteria
         Caption         =   "Files filter :"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   0
         Width           =   1335
      End
   End
   Begin VB.CommandButton cmdExit
      BackColor       =   &H00C0C0C0&
      Caption         =   "E&xit"
      Height          =   720
      Left            =   120
      TabIndex        =   0
      Top             =   3240
      Width           =   4575
   End
   Begin VB.Shape Shape1
      BorderWidth     =   3
      Height          =   6135
      Left            =   4920
      Top             =   120
      Width           =   6255
   End
   Begin LLILib.LLI Image1
      Height          =   6135
      Left            =   4920
      TabIndex        =   7
      Top             =   120
      Width           =   6255
      _Version        =   65539
      _ExtentX        =   11033
      _ExtentY        =   10821
      _StockProps     =   0
      Blob            =   "ViewImg.frx":0000
   End
End
Attribute VB_Name = "WinSeek"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim SearchFlag As Integer   ' Used as flag for cancel and other operations.

Private Sub cmdExit_Click()
    If cmdExit.Caption = "E&xit" Then
        End
    Else                    ' If user chose Cancel, just end Search.
        SearchFlag = False
    End If
End Sub



Private Sub Command1_Click()
    Image1.Fit 4
End Sub

Private Sub Command2_Click()
    Image1.Fit 1
End Sub


Private Sub Command3_Click()
    Image1.Fit 0
End Sub

Private Sub Command4_Click()
    Image1.Fit 3
End Sub


Private Sub DirList_Change()
    ' Update the file list box to synchronize with the directory list box.
    filList.Path = dirList.Path
End Sub

Private Sub DirList_LostFocus()
    dirList.Path = dirList.List(dirList.ListIndex)
End Sub

Private Sub DrvList_Change()
    On Error GoTo DriveHandler
    dirList.Path = drvList.Drive
    Exit Sub

DriveHandler:
    drvList.Drive = dirList.Path
    Exit Sub
End Sub

Private Sub filList_Click()

    If InStr(UCase(filList.FileName), ".BMP") > 0 Or InStr(UCase(filList.FileName), ".TIF") Or InStr(UCase(filList.FileName), ".JPG") Or InStr(UCase(filList.FileName), ".PNG") Then
        Image1.FileName = dirList.Path + "\" + filList.FileName
        WinSeek.Caption = "Image Viewer - " + dirList.Path + "\" + filList.FileName
    Else
        Beep
    End If
End Sub

Private Sub FitBest_Click()
    Image1.Fit 4
End Sub

Private Sub FitInHeight_Click()
    Image1.Fit 2
End Sub

Private Sub FitInWidth_Click()
    Image1.Fit 3
End Sub


Private Sub FitRelease_Click()
    Image1.Fit 0
End Sub

Private Sub Form_Load()
    Image1.CallBackCount = 0
            ' When the CallBackCount is set to 0, the OCX is taking care of the Gauge
            ' When the CallBackCount is set to x>0, the CallBack event is called during each process
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub


Private Sub LLI1_CallBack(ByVal ImageControl As Object, ByVal dwType As Long, ByVal dwAction As Long, ByVal dwDevice As Long, ByVal dwFormat As Long)
    Beep
End Sub

Private Sub LLI1_PostLoad(ByVal FileName As String)
    'LLI1.Fit 4  ' Fit to the best
End Sub

Private Sub txtSearchSpec_Change()
    ' Update file list box if user changes pattern.
    filList.Pattern = txtSearchSpec.Text
End Sub

Private Sub txtSearchSpec_GotFocus()
    txtSearchSpec.SelStart = 0          ' Highlight the current entry.
    txtSearchSpec.SelLength = Len(txtSearchSpec.Text)
End Sub